#!/usr/bin/perl -w

#=======================================================================
# findrev
# File ID: f240c034-f742-11dd-a833-000475e441b9
# Locate a Subversion revision based on used defined criteras.
#
# Character set: UTF-8
# ©opyleft 2007– Øyvind A. Holm <sunny@sunbase.org>
# License: GNU General Public License version 2 or later, see end of 
# file for legal stuff.
#=======================================================================

use strict;
use Getopt::Long;

$| = 1;

our $Debug = 0;

our %Opt = (

    'after' => "",
    'before' => "",
    'debug' => 0,
    'exec' => "",
    'help' => 0,
    'ignore-externals' => 0,
    'revision' => "",
    'verbose' => 0,
    'version' => 0,
    'want' => 0,

);

our $progname = $0;
$progname =~ s/^.*\/(.*?)$/$1/;
our $VERSION = "0.00";

my $CMD_SVN = "svn";

Getopt::Long::Configure("bundling");
GetOptions(

    "after|A=s" => \$Opt{'after'},
    "before|B=s" => \$Opt{'before'},
    "debug" => \$Opt{'debug'},
    "exec|e=s" => \$Opt{'exec'},
    "help|h" => \$Opt{'help'},
    "ignore-externals" => \$Opt{'ignore-externals'},
    "revision|r=s" => \$Opt{'revision'},
    "verbose|v+" => \$Opt{'verbose'},
    "version" => \$Opt{'version'},
    "want|w=s" => \$Opt{'want'},

) || die("$progname: Option error. Use -h for help.\n");

$Opt{'debug'} && ($Debug = 1);
$Opt{'help'} && usage(0);
if ($Opt{'version'}) {
    print_version();
    exit(0);
}

my ($Start, $End) = (1, "HEAD");

if (length($Opt{'revision'})) {
    if ($Opt{'revision'} =~ /^(\d*):(\d*|head)$/i) {
        D("regexp good");
        length($1) && ($Start = $1);
        length($2) && ($End = $2);
    } else {
        die("$progname: Invalid revision range in --revision (-r) parameter\n");
    }
}

D("Start = '$Start', End = '$End'");

if (!length($Opt{'exec'})) {
    die("$progname: No --exec (-e) parameter specified. You might want to consult '$progname --help'.\n");
}

my $File;

if ($#ARGV == -1) {
    $File = ".";
} elsif ($#ARGV == 0) {
    $File = $ARGV[0];
} else {
    die("$progname: Only one file or directory name allowed\n");
}

find_revision($Opt{'want'}, $File, $Start, $End, $Opt{'exec'}, $Opt{'before'}, $Opt{'after'});

my $Found = 0;

sub find_revision {
    # Scan a specific revision range for the first merge conflict and 
    # return the revision number
    # {{{
    my ($Want, $File, $Start, $End, $Exec, $Before, $After) = @_;

    D("find_revision('$Want', '$File', '$Start', '$End', '$Exec', '$Before', '$After')");
    print("$progname: $File: Scanning revision range r$Start:$End " .
          "for return value $Want\n");
    my @Array = revisions($File, $Start, $End);
    if (!scalar(@Array)) {
        print("No revisions found.\n");
        return undef;
    }

    my $rev_count = scalar(@Array);
    printf("$rev_count revision%s to check\n", $rev_count == 1 ? "" : "s");
    print("(" . join(", ", @Array) . ")\n");

    my $min_block = 0;
    my ($min_pos, $max_pos) = (0, $rev_count);

    my $last_mid = 0;
    my $first_fail = 0;
    my $last_good = 0;
    my $has_checked = 0;

    while (1) {
        my $mid_pos = int(($min_pos + $max_pos) / 2);
        last if ($has_checked && ($mid_pos == $last_mid));
        my $Rev = $Array[$mid_pos];
        D("max_pos = '$max_pos', scalar(");
        printf("==== Checking revision %lu (%lu:%lu, %lu left)...",
            $Rev, $Array[$min_pos], $Array[$max_pos-1], $max_pos - $min_pos);
        my $exit_code = test_ok($Want, $File, $Rev, $Exec, $Before, $After);
        if ($exit_code != $Opt{'want'}) {
            print("NOT FOUND (code $exit_code), going up\n");
            $min_pos = $mid_pos;
            D("min_pos set to '$mid_pos'");
            if (!$last_good || ($Rev > $last_good)) {
                $last_good = $Rev;
            }
        } else {
            print("FOUND (code $exit_code), going down\n");
            $max_pos = $mid_pos;
            D("max_pos set to '$mid_pos'");
            if (!$first_fail || ($Rev < $first_fail)) {
                $first_fail = $Rev;
            }
        }
        $has_checked = 1;
        $last_mid = $mid_pos;
    }
    print($first_fail
        ? "Found at r$first_fail. "
        : "Condition not found. "
    );
    print($last_good
        ? "Last revision where the test fails at r$last_good.\n"
        : "Condition found in all revisions.\n"
    );

    # }}}
} # find_revision()

sub revisions {
    # Return an array of revision numbers from a specific revision range 
    # for a version controlled element
    # {{{
    my ($File, $Start, $End) = @_;
    D("revisions('$File', '$Start', '$End')");
    my $safe_file = escape_filename($File);
    my $Data = "";
    my @Revs = ();

    my $pipe_cmd = "$CMD_SVN log --xml -r$Start:$End $safe_file\@$End |";
    D("opening pipe '$pipe_cmd'");
    if (open(PipeFP, $pipe_cmd)) {
        $Data = join("", <PipeFP>);
        close(PipeFP);
        $Data =~ s/<logentry\b.*?\brevision="(\d+)".*?>/push(@Revs, "$1")/egs;
    }
    if ($Revs[0] eq $Start) {
        # splice(@Revs, 0, 1);
    }
    return(@Revs);
    # }}}
} # revisions()

sub mysyst {
    # Customised system() {{{
    my @Args = @_;
    my $system_txt = sprintf("system(\"%s\");", join("\", \"", @Args));
    D("$system_txt");
    deb_wait();
    msg(1, "@_\n");
    system(@_);
    # }}}
} # mysyst()

sub escape_filename {
    # Kludge for handling file names with spaces and characters that 
    # trigger shell functions
    # {{{
    my $Name = shift;
    # $Name =~ s/\\/\\\\/g;
    # $Name =~ s/([ \t;\|!&"'`#\$\(\)<>\*\?])/\\$1/g;
    $Name =~ s/'/\\'/g;
    $Name = "'$Name'";
    return($Name);
    # }}}
} # escape_filename()

sub deb_wait {
    # Wait until Enter is pressed if $Debug and verbose >= 2 {{{
    $Debug || return;
    if ($Opt{'verbose'} >= 2) {
        print("debug: Press ENTER...");
        <STDIN>;
    }
    # }}}
} # deb_wait()

sub test_ok {
    # {{{
    my ($Want, $File, $Rev, $Exec, $Before, $After) = @_;
    my $Retval;

    D("test_ok(Want='$Want', File='$File', Rev='$Rev', Exec='$Exec', Before='$Before', After='$After')");
    print("svn update...");
    if ($Opt{'ignore-externals'}) {
        mysyst($CMD_SVN, "update", "--ignore-externals", "-q", "-r$Rev", $File);
    } else {
        mysyst($CMD_SVN, "update", "-q", "-r$Rev", $File);
    }
    if (length($Before)) {
        print("execute before:\n");
        mysyst($Before);
    }
    print("run test:\n");
    $Retval = mysyst($Exec);
    if (length($After)) {
        print("execute after:\n");
        mysyst($After);
    }
    D("test_ok() returns '$Retval'");
    return($Retval);
    # }}}
} # test_ok()

sub print_version {
    # Print program version {{{
    print("$progname v$VERSION\n");
    # }}}
} # print_version()

sub usage {
    # Send the help message to stdout {{{
    my $Retval = shift;

    if ($Opt{'verbose'}) {
        print("\n");
        print_version();
    }
    print(<<END);

Usage: $progname [options] [path]

Do a binary search through revisions of a Subversion working copy for 
special conditions. A test script/command and script/command before and 
after each test can be supplied. The script will search through the 
specified revisions (or 1:HEAD if missing) until it finds the first 
revision the test script succeeds.

Test script return values:
  0 (or a value specified with -w/--want) means that the condition is 
    true, and it tries a lower revision number next time.
  Anything else means the test has failed, and it tries a higher 
    revision next time.

A path can be specified; the program will operate on this element, and 
using the same revision range as the element.

Options:

  -A x, --after x
    Execute command x after the test has run.
  -B x, --before x
    Execute command x before the test is run.
  -e x, --exec x
    Execute command x to check revisions.
  -h, --help
    Show this help.
  --ignore-externals
    Don’t update svn externals.
  -r x:y, --revision x:y
    Limit the search to revision range x:y. Default: 1:HEAD.
  -v, --verbose
    Increase level of verbosity. Can be repeated.
  -w x, --want x
    Search for return code x instead of the default 0.
  --version
    Print version information.
  --debug
    Print debugging messages.

END
    exit($Retval);
    # }}}
} # usage()

sub msg {
    # Print a status message to stderr based on verbosity level {{{
    my ($verbose_level, $Txt) = @_;

    if ($Opt{'verbose'} >= $verbose_level) {
        print(STDERR "$progname: $Txt\n");
    }
    # }}}
} # msg()

sub D {
    # Print a debugging message {{{
    $Debug || return;
    my @call_info = caller;
    chomp(my $Txt = shift);
    my $File = $call_info[1];
    $File =~ s#\\#/#g;
    $File =~ s#^.*/(.*?)$#$1#;
    print(STDERR "$File:$call_info[2] $$ $Txt\n");
    return("");
    # }}}
} # D()

__END__

# This program is free software: you can redistribute it and/or modify 
# it under the terms of the GNU General Public License as published by 
# the Free Software Foundation, either version 2 of the License, or (at 
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License 
# along with this program.
# If not, see L<http://www.gnu.org/licenses/>.

# vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
